home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / DDCTRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-06  |  7.8 KB  |  259 lines
  1. unit Ddctrl;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DB, DBTables, inifiles, grids;
  8. const
  9.     FieldTypeStr : array[ftunknown..ftgraphic] of string[8] =
  10.       ('Unknown', 'String', 'Smallint', 'Integer', 'Word',
  11.        'Boolean', 'Float', 'Currency', 'BCD', 'Date', 'Time',
  12.        'DateTime', 'Bytes', 'VarBytes', 'Blob', 'Memo', 'Graphic');
  13.     FieldTypeLtr : array[ftunknown..ftgraphic] of string[1] =
  14.       ('U', 'S', 'I', 'N', 'W',
  15.        'L', 'F', 'C', 'B', 'D', 'T',
  16.        'A', 'Y', 'V', 'O', 'M', 'G');
  17.  
  18. type
  19.   DDValidationtype = (IsValidDD, DoesNotExist, ExistbutnotDD, NewDD, EmptyString );
  20.  
  21.   TDataDictCtrlForm = class(TForm)
  22.     DictDB: TDatabase;
  23.     DictTable: TTable;
  24.     DictQuery: TQuery;
  25.     DictSource: TDataSource;
  26. {  tdictctrl = class(TComponent)}
  27.   private
  28.     FiniFile : TiniFile;
  29.     FCtrlDictName : Tfilename; {fully qualified name}
  30.     FDictStatus : DDValidationType;
  31.     FDBSGGood : boolean;
  32.     FTableList : tStrings;
  33.     FDBSG : Tstringgrid;  {non-documentation part of dictionary}
  34.     FUpdated : Tdatetime; {info on current dictionary}
  35.     FDictsize : longint;
  36.     FnumRecords,
  37.     Fnumtables,
  38.     FnumFields : integer;
  39.     procedure ReadIniFile;
  40.     function getDictPath : tfilename;
  41.     procedure setDictPath( tmpstr : tfilename);
  42.     function getDictTable : tfilename;
  43.     procedure setDictTable (tmpstr : tfilename);
  44.   protected
  45.     Constructor create(Aowner : Tcomponent); override;
  46.     function OpenDD(const pathname, tablename : string): boolean;
  47.     function CheckOutDD(const Fulltablename : string): DDValidationtype;
  48.  
  49.     { Protected declarations }
  50.   public
  51.  
  52.     { Public declarations }
  53.   published
  54.     property DictStatus: DDValidationType read FDictStatus;
  55.     property FullDDName : tFilename read FCtrlDictName write FCtrlDictName;
  56.     property DictPathName: Tfilename read getDictPath;
  57.     property DictTableName: Tfilename read getDictTable;
  58.     property LastUpdate: tDateTime read Fupdated;
  59.     property DictSize: longint read FDictSize;
  60.     property NumRecords: integer read FNumRecords;
  61.     property numtables: integer read fNumtables;
  62.     property numfields: integer read fNumFields;
  63.     property DBSGExists : boolean read FDBSGGood;
  64.   end;
  65.  
  66.  
  67. procedure Register;
  68.  
  69. var
  70. {  DictCtrl : TDictCtrl;}
  71.   DataDictCtrlForm: TDataDictCtrlForm;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76. uses utils;
  77. const
  78.    {indexes into DBSG columns}
  79.       tablename = 0;  {string 20}
  80.       tabletype = 1;  {string 20}
  81.       fieldname = 2;  {string[20];}
  82.       tag       = 3;  {string 20  tfield.tag}
  83.       scrprompt = 4;  {string[40]; {tfield.DisplayName}
  84.       scrformat = 5;  {string[80]; {tfield.DisplayText -- an editmask}
  85.       grdprompt = 6;  {string[10];}
  86.       grdwidth  = 7;  {smallint    {tfield.DisplayWidth}
  87.       fldtype   = 8;  {string[1];  {FieldTypeLtr}
  88.       fldlen    = 9;  {smallint    {tfield.size}
  89.       flddec    = 10; {smallint}
  90.       fldidx    = 11; {boolean;}
  91.       idxexp    = 12; {string;}
  92.       tab_order = 13; {integer;}
  93.       isrequired  = 14; {boolean;    {tfield.required}
  94.       defaultis   = 15; {string[80];}
  95.       editmaskis  = 16; {string[80]; {tfield.editMask}
  96.       minval    = 17; {ftfloat  tfield.minvalue}
  97.       maxval    = 18; {ftfloat  tfield.maxvalue}
  98.       vallist   = 19; {ftmemo   list of valid strings}
  99.       { define      documentation only
  100.         validvalue  documentation only
  101.         notes       documentation only}
  102.       hintTxt   = 20;  {string 120}
  103.       helpid    = 21;  {longint;}
  104.       {help, memo only used if helpid not null or 0}
  105.       haslink   = 22;  {boolean;}
  106.       srclinktbl = 23; {string[20];}
  107.       srclinkfld = 24; {string[20];}
  108.       iscalc     = 25; {boolean;}
  109.       formula    = 26; {memo only used if iscalc true}
  110. type
  111.    TDictCtrlStringGrid = TStringGrid;
  112. var
  113.    DBSG : TDictCtrlStringGrid;
  114.  
  115. Procedure TDataDictCtrlForm.ReadIniFile;
  116. begin
  117.   FIniFile := TiniFile.Create(appname+'.ini');
  118.   FCtrlDictName := FiniFile.ReadString('CtrlDict', 'current', appname+'.dbf');
  119.   FiniFile.free;
  120. end;
  121.  
  122. function TDataDictCtrlForm.getDictPath : tfilename;
  123. begin
  124.   result := extractFilePath(FCtrlDictName);
  125. end;
  126. procedure TDataDictCtrlForm.setDictPath( tmpstr : tfilename);
  127. begin
  128.   FCtrlDictName := tmpstr;
  129. end;
  130. function TDataDictCtrlForm.getDictTable : tfilename;
  131. begin
  132.   result := extractFileName(FCtrlDictName);
  133. end;
  134. procedure TDataDictCtrlForm.setDictTable (tmpstr : tfilename);
  135. begin
  136. end;
  137.  
  138. constructor TDataDictCtrlForm.create(Aowner : Tcomponent);
  139. begin
  140.   inherited create(Aowner);
  141.   readIniFile;
  142.   DictDB.Databasename := 'DataDictCtrlFormDB';
  143.   if CheckOutDD(FCtrlDictName) = IsValidDD
  144.     then begin
  145.       {first check it out}
  146.       {pull data into stringgrid?
  147.        or set up a permanent link/ query table
  148.        with data to modify current app
  149.        }
  150.       end
  151.     else begin
  152.       {some kind of message about no dictionary
  153.        present?
  154.        }
  155.       end;
  156. end;
  157.  
  158.  
  159. function TDataDictCtrlForm.openDD(const pathname, tablename : string): boolean;
  160. begin
  161.   try
  162.     DictDB.close;
  163.     DictDB.Params.clear;
  164.     DictDB.Params.Add('PATH='+PathName);
  165.     DictDB.open;
  166.     DictTable.DatabaseName:= DictDB.databasename;
  167.     DictTable.tablename := TableName;
  168.     DictTable.Active:= True;
  169.     DictSource.DataSet:= DictTable;
  170.     DictQuery.databaseName := DictDB.databasename;
  171.     DictQuery.dataSource := DictSource;
  172.     DictQuery.close;
  173.     DictQuery.sql.clear;
  174.     DictQuery.params.clear;
  175.     result := true;
  176.   except
  177.      on EdataBaseError do begin
  178.        screen.cursor := crDefault;
  179.        MessageDlg('Could not open '+pathname + ' '+tablename, mtInformation, [mbOK], 0);
  180.        result := false;
  181.        end;
  182.      end; {of exceptions}
  183. end;
  184.  
  185. function TDataDictCtrlForm.CheckOutDD(const Fulltablename : string): DDValidationtype;
  186. var
  187.     tablefound : boolean;
  188.     sqlstr,
  189.     thistable : string;
  190.     tablenum : integer;
  191.     FileInfo : TsearchRec;
  192.     tableField : tField;
  193.  
  194. begin
  195.   result := isValidDD;
  196.   fnumtables := 0;  fnumFields := 0; fDictsize := 0; fNumRecords := 0;
  197.   FTableList := tstringlist.create;
  198.   if fileExists(fulltablename)
  199.     then begin
  200.       FindFirst(fulltablename, faAnyfile, fileinfo);
  201.       FUpdated := fileDateToDateTime(Fileinfo.time);
  202.       fDictSize := FileInfo.size;
  203.       {not total size, should also get size of .dbt }
  204.       end
  205.     else begin
  206.       result := DoesNotExist;
  207.       exit;
  208.       end;
  209.   if openDD(DictPathName, DictTableName)
  210.     then begin
  211.       fnumrecords := DictTable.RecordCount;
  212.       sqlstr := 'SELECT * FROM '+DictTableName;
  213.       Dictquery.sql.add(sqlstr);
  214.       Dictquery.prepare;
  215.       Dictquery.open;
  216.       Dictquery.first;
  217.       { get tablenames in data dictionary, stick in M_tableList lines}
  218.       if DictQuery.findfield('TABLE_NAME') = nil
  219.         then begin
  220.            result := ExistButNotDD;
  221.            exit;
  222.            end;
  223.       ftableList.add(DictQuery.findfield('TABLE_NAME').text);  {get first one}
  224.       inc(fnumfields);
  225.       DictQuery.next;
  226.       while not DictQuery.eof do begin
  227.         tablefound := false;
  228.         thistable := DictQuery.findfield('TABLE_NAME').text;
  229.         inc(fnumFields);
  230.         for tablenum := 0 to ftablelist.count - 1 do
  231.           if ftableList.strings[tablenum] = thistable
  232.              then begin
  233.                 tablefound := true;
  234.                 break;
  235.                 end;
  236.           {done looking for thistable}
  237.         if not tablefound
  238.           then  ftablelist.add(thistable);
  239.         DictQuery.next;
  240.         end; {while searching for table names}
  241.     DictQuery.close;
  242.     end
  243.   else begin
  244.     result := ExistbutnotDD;
  245.     end;
  246. end;
  247.  
  248.  
  249. procedure Register;
  250. begin
  251.   RegisterComponents('Synature', [tdatadictctrlform]);
  252. end;
  253.  
  254. Initialization
  255.  
  256. DataDictCtrlForm.Create(application);
  257.  
  258. end.
  259.